Attribute VB_Name = "Module2"
Sub newDnB()
Dim x As Integer

x = Columns("CT").Column
Dim ilastrow As Long, i As Long, rRange As Range, sh As Worksheet
Set sh = ActiveSheet
ilastrow = sh.Cells(Rows.Count, 1).End(xlUp).Row
For i = 3 To ilastrow
    If sh.Cells(i, 1) <> "" And sh.Cells(i, 1) <> "somma" And sh.Cells(i, 1) <> "Operatori" Then
        If rRange Is Nothing Then
            Set rRange = sh.Range(sh.Cells(i, 1), sh.Cells(i, 1))
            Set rRange = Union(rRange, sh.Range(sh.Cells(i, x - 3), sh.Cells(i, x + 1)))
            Set rRange = Union(rRange, sh.Cells())
            
            
        Else
            Set rRange = Union(rRange, sh.Range(sh.Cells(i, 1), sh.Cells(i, 1)))
            Set rRange = Union(rRange, sh.Range(sh.Cells(i, x - 3), sh.Cells(i, x + 1)))
        End If
    End If
Next i
rRange.Select
Dim TmpName As String
On Error Resume Next
Application.DisplayAlerts = False
TmpName = ActiveSheet.Name & "(Tmp)"
Sheets(TmpName).Delete
Selection.Copy

NewFN = Application.GetOpenFilename(FileFilter:="Excel Files (*.xlsx), *.xlsx", Title:="Please select a file")
Set wb = Workbooks.Open(NewFN)
wbLastrow = wb.Cells(Rows.Count, 1).End(xlUp).Row
With ActiveSheet
    'With Sheets.Add
        '.Name = TmpName
        .Cells(Cells.Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues
        '.PasteSpecial xlPasteColumnWidths
        '.Cells(wbLastrow + 1, 1).Select
        '.Past
        '.Cells.Style = "Normal"
        'Selection.Style = "Normal"
        
        '.PrintOut Copies:=1, Collate:=True
        '.Delete
    'End With
    '.Activate
End With
Application.CutCopyMode = False
Application.DisplayAlerts = True

End Sub

